perm filename CLOSE.1[AID,LSP]1 blob
sn#559612 filedate 1981-01-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Helps close files that are randomly open
C00005 ENDMK
C⊗;
;;; Helps close files that are randomly open
(declare (fasload util fas dsk (aid rpg)))
(macrodef real-tyi ()
(while (member (tyipeek) '(13. 10.)) do (tyi)) (tyi))
(declare (special close-file-start-address))
(setq close-file-start-address (getddtsym 'chntb))
;(cond ((status features onesegment)
; (cond ((status features paging)
; (setq close-file-start-address 149.))
; (t (setq close-file-start-address 190.))))
; (t (cond ((status features ddt) (setq close-file-start-address 6846.))
; (t (setq close-file-start-address 190.)))))
(defun closer ()
(let file ← nil
end ← (+ close-file-start-address 17.)
lm ← (status linmode) do
(sstatus linmode nil)
(do ((i close-file-start-address (1+ i)))
((= i end) t)
(setq file (munkam (examine i)))
(and file
(not (member 'tty (car (status filemode file))))
(progn (terpri)
(princ file)
(princ '| - Close this one? |)
(member (real-tyi) '(89. 121.)))
(progn (close file) (terpri) (princ file) (princ '| closed!|))))
(sstatus linmode lm)
(terpri)
'done))
(defun closeall ()
(let file ← nil
end ← (+ close-file-start-address 17.)
do
(do ((i close-file-start-address (1+ i)))
((= i end) t)
(setq file (munkam (examine i)))
(and file
(not (member 'tty (car (status filemode file))))
(progn (close file) (terpri) (princ file) (princ '| closed!|))))
(terpri)
'done))